home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 21
/
Cream of the Crop 21 (Terry Blount) (October 1996).iso
/
program
/
qbsvga.zip
/
MOUSDEMO.BAS
< prev
next >
Wrap
BASIC Source File
|
1996-07-01
|
4KB
|
129 lines
'
' This is a simple MAIN routine to demonstrate use of the QBSVGA's mouse
' routines. (You still need to link with QB.LIB or run QB with the /L
' option.)
'
' Put the contents of REGTYPE.INC here.
'
' Don't do anything if mouse driver isn't present. (QRYMOUSE is the only
' mouse routine (indeed, the only one of any of the QBSVGA routines) that
' you can call without first setting the video mode with BSCREEN.)
'
IF QRYMOUSE=-1 THEN
'
' Mouse position detector only works with graphics screens.
'
CALL BSCREEN(14!,7!,0!,0!)
'
' For now, SETLIM will not be used to restrict mouse cursor movement past
' the default manner in which it was used in subroutine MOUSINIT (called
' by BSCREEN). A later example will use SETLIM explicitly. If it was
' going to be used here, the most logical place for it would be right
' here, before beginning a programming sequence using subroutine GETPOS.
'
A$=" Move mouse around and press a button. To terminate this example,;"
B$="leave the mouse at the same position and press any combination of"
C$="buttons twice."
CALL BPRINT("EEK! A RODENT! HELP!")
CALL BPRINT(" ")
CALL BPRINT("(Sorry, I couldn't resist.)")
CALL BPRINT(" ")
CALL BPRINT(A$)
'
' The following call to BPRINT is used to put a "," at the end of the
' printed string represented by A$. (BPRINT won't allow a comma to be
' explicitly printed at the end of a line.)
'
CALL BPRINT(" ")
CALL BPRINT(B$)
CALL BPRINT(C$)
'
' If output position from GETPOS is same as last position, terminate
' loop.
'
X=-1 : Y=-1
TOP1:
XL=X : YL=Y
CALL GETPOS(X,Y,BUTTON)
CALL BLOCATE(10!,1!)
A$="("+LTRIM$(RTRIM$(STR$(X)))+" , "+LTRIM$(RTRIM$(STR$(Y)))+")."
A$="Cursor position = "+A$+" "
CALL BPRINT(A$)
IF BUTTON=0 THEN BUT$="left"
IF BUTTON=1 THEN BUT$="right"
IF BUTTON=2 THEN BUT$="middle"
CALL BPRINT("You pressed the "+BUT$+" button. ")
IF ABS(XL-X)>.001 OR ABS(YL-Y)>.001 THEN GOTO TOP1
'
' Use new example restricting cursor motion.
'
CALL BSCREEN(15!,7!,0!,0!)
A$="Now I'm going to restrict the motion of the cursor in a higher video mode."
CALL BPRINT(A$)
CALL BPRINT(" ")
A$=" Move mouse around and press a button. To terminate example, leave"
B$="the mouse at the same position and press any combination of buttons"
C$="twice."
CALL BPRINT(A$)
CALL BPRINT(B$)
CALL BPRINT(C$)
CALL SETLIM(100!,100!,HMAX-100,VMAX-100)
'
' Draw box to show where mouse limits are.
'
CALL BLINE(100!,100!,HMAX-100,VMAX-100,7!,"B")
X=-1 : Y=-1
TOP2:
XL=X : YL=Y
CALL GETPOS(X,Y,BUTTON)
CALL BLOCATE(34!,1!)
A$="("+LTRIM$(RTRIM$(STR$(X)))+" , "+LTRIM$(RTRIM$(STR$(Y)))+")"
A$="Position = "+A$+" "
IF BUTTON=0 THEN BUT$="left"
IF BUTTON=1 THEN BUT$="right"
IF BUTTON=2 THEN BUT$="middle"
CALL BPRINT(A$)
CALL BPRINT("Button = "+BUT$+" ")
IF ABS(XL-X)>.001 OR ABS(YL-Y)>.001 THEN GOTO TOP2
'
' Do example involving dragging box routine.
'
CALL BCLS(0!)
CALL SETLIM(0!,0!,HMAX,VMAX)
'
' Change colors.
'
MCOLOR=13
A$=" Press and hold a button and move mouse around. Release button when recta"
A$=A$+"ngle"
B$="is drawn however you want."
CALL BPRINT(A$)
CALL BPRINT(B$)
CALL BOXDRAG(XP,YP,XR,YR,BUTTON)
CALL BCLS(0!)
A$=" Press a key and I will use the outputs of the BOXDRAG mouse routine to"
B$="redraw your box."
CALL BPRINT(A$)
CALL BPRINT(B$)
10 IF INKEY$="" THEN GOTO 10
XLEFT=XP : XRIGHT=XR : IF XR<XP THEN XLEFT=XR : XRIGHT=XP
YLEFT=YP : YRIGHT=YR : IF YR<YP THEN YLEFT=YR : YRIGHT=YP
CALL BCLS(0!)
CALL BLINE(XLEFT,YLEFT,XRIGHT,YRIGHT,7!,"B")
COLUMN=INT(XLEFT/8+.001)+2 : ROW=INT(YLEFT/16+.001)+2
CALL BLOCATE(ROW,COLUMN)
CALL BPRINT("This should be your box; press a key to quit.")
CALL BLOCATE(ROW+1,COLUMN)
CALL BPRINT("(Notice how I changed colors just to show that")
CALL BLOCATE(ROW+2,COLUMN)
CALL BPRINT("I was actually recreating your box?)")
20 IF INKEY$="" THEN GOTO 20
CALL BSCREEN(0!,7!,0!,0!)
ELSE
PRINT
PRINT "Install mouse driver!"
END IF
END
'
' Put the contents of QBSVGA.BAS here.